Skupljanje podataka za EW-NBS

Univariate analiza malihih preduzeća (nastavak)

Potrebno je pre svega razdvojiti uzorak na validacioni i estimacioni. U nacelu pravilo je da se uzorak deli na 70:30 na stranu estimacije,i u slucaju malih preduzeca to cemo i koristiti. Pa, pocnimo.

#izracunam broj redova
broj.red.small<-nrow(small)
broj.difolta.small<-sum(as.numeric(small$default.y==1))
procenat.difolta<-broj.difolta.small/broj.red.small

set.seed(45)
#zbog reprodukcije
sample.small <-
sample(broj.red.small, size = round(0.75 * broj.red.small, 0))
small.training <- small[sample.small, ]
small.test <- small[-sample.small, ]

Testiranje radne hipoteze, diskriminativnosti, korelacione matrice

Jos jednom cemo pregledati varijable:

#rpivotTable(lrge.training)
summary_table.small<-t(sapply(small.training[,11:43],my.summary,arg=T))
tr_summary_table.small<-t(summary_table.small)
formatRound(
            datatable(
                      summary_table.small,caption = "Tabela 3.:Sumarni prikaz",
                      filter = 'none'
                      ),
            columns = colnames(summary_table.small)
           )

Generalna preporuka je da se radna hipoteza testira pre tretmana nedostajućih vrednosti budući da će se nedostajuće vrednosti popunjavati uslovno od stanja solventnosti duznika. Samim tim ovde cemo kao prvi vid selekcije ispitati radnu hipotezu kako kontinualnih tako i kategorickih varijabli. Počećemo sa kontinualnim¹ i analizu raditi u paru sa proverom diskriminativnosti varijabli. Još u Tabeli 3 vidimo velika odstupanja srednje vrednosti od medijane i trimovanog proseka, buduci da je prosek kao mera centralne tendencije osetljiva na autlajere odlucujemo se da posmatramo medijanu i trimovan prosek, samim tim mogucnost t testa otpada. Dalje, sledeci preporuke iz literature ovaj deo analize osloniti na posmatranje box plotova i bice dopunjen diskriminativnom analizom AUROC-a. Pri testiranju korelacija prag selekcije postavljamo na 0.5 i od dve biramo onu varijablu koja ima vecu diskriminacionu moc.

Kod kategorickih varijabli posmatracemo tabele frekvencija tamo gde to bude imalo smisla i sprovesti Chi-squared test. Ovom prilikom potrebno je i pregrupisati ove varijable tako da budu zadovoljeni kriterijumi:

• broj difolta po kategoriji kategoricke varijable mora biti minimum 5
• ukupan broj duznika po kategoriji kategoricke varijable mora biti veci od sto
• pravilo 1 u 10, za svakih 10 difolta možemo dodati jednu objašnjavajuću, ovo pravilo nam sluzi samo kao vodilja
• default rate mora biti statisticki razlicit od default rate-a ukupnog uzorka, inace se vrsi pregrupacija
• iako cemo ispitati hipotezu sagledavanjem tabela frekvencija, poslednju rec ce nam dati sami model i njegove p vrednosti, odnosno likelihood ratio test

Prvo pregledajmo samu distribuciju jos jednom, mada su neke stvari vec jasne iz Tabele 3 hajde ipak da pogledamo.
Prvo kreiramo funkciju za plotiranje: qq plota, box plota, poredjenja gustina verovatnoce (kernela empiriskih distribucija verovatnoce) i konacno za proveru diskriminacije ROC krive.

#delimo uzorak na kontinualne i kategoricke
small.training.continualne<-small.training[,c(7,6,11,13:43)]
small.training.kategoricke<-small.training[,c(7,8,9,10,12)]
small.test.continualne<-small.test[,c(7,6,11,13:43)]
small.test.kategoricke<-small.test[,c(7,8,9,10,12)]

Krećemo sa opisom svake varijable ponaosob:

Neprekidne promenljive:

Udeo ispravke u ukupnim kreditima

---

#definisem funkciju za plotovanje
ploting(small.training,6,7)

Ignoring unknown parameters: positionRemoved 1796 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-nismo postavili radnu hipotezu za ovu varijablu
• Diskriminativnost - postoji na 95% sigurnosti
• autlajeri - naravno ima ih ima
• normalnost - ma da…

Broj zaposlenih

---

#definisem funkciju za plotovanje
ploting(small.training,11,7)

Ignoring unknown parameters: positionRemoved 2621 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-nismo postavili radnu hipotezu za ovu varijablu
• Diskriminativnost - ima je
• autlajeri - naravno ima ih
• normalnost - ma da…

Rigorozni racio redukovane (monetarne) likvidnosti

---

#definisem funkciju za plotovanje
ploting(small.training,13,7)

Ignoring unknown parameters: positionRemoved 3268 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima na 95% znacajnosti
• autlajeri - naravno ima ih
• normalnost - ma da…

Racio novcane likvidnosti (Cash_ratio)

---

#definisem funkciju za plotovanje
ploting(small.training,14,7)

Ignoring unknown parameters: positionRemoved 3208 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima na 95% znacajnosti
• autlajeri - naravno ima ih
• normalnost - ma da…

Opsti racio likvidnosti

---

#definisem funkciju za plotovanje
ploting(small.training,15,7)

Ignoring unknown parameters: positionRemoved 3552 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-nezadovoljena, veci difolt kod vecih vrednosti
• Diskriminativnost - ima na 95% znacajnosti ali je mala, uzimacemo samo preko 55%
• autlajeri - naravno ima ih
• normalnost - ma da…

Stepen_zaduzenosti

---

#definisem funkciju za plotovanje
ploting(small.training,16,7)

Ignoring unknown parameters: positionRemoved 1723 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod vecih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Interest Coverage Ratio

---

#definisem funkciju za plotovanje
ploting(small.training,17,7)

Ignoring unknown parameters: positionRemoved 3558 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da, ali bar lici na nesto normalno…

Racio pokrica obrtne imovine

---

#definisem funkciju za plotovanje
ploting(small.training,18,7)

Ignoring unknown parameters: positionRemoved 3590 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da

Racio obrta potrazivanja od kupaca

---

#definisem funkciju za plotovanje
ploting(small.training,19,7)

Ignoring unknown parameters: positionRemoved 3058 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da, vise kao \(\tilde\chi^2\)nost hihihi, kapiras hi kao hi distribucija :) …

Racio obrta poslovne imovine

---

#definisem funkciju za plotovanje
ploting(small.training,20,7)

Ignoring unknown parameters: positionRemoved 3104 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Gotovinski ciklus 1

---

#definisem funkciju za plotovanje
ploting(small.training,21,7)

Ignoring unknown parameters: positionRemoved 3336 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-nezadovoljena, veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Vreme vezivanja zaliha

---

#definisem funkciju za plotovanje
ploting(small.training,22,7)

Ignoring unknown parameters: positionRemoved 3398 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod vecih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Vreme kreditiranja kupaca

---

#definisem funkciju za plotovanje
ploting(small.training,23,7)

Ignoring unknown parameters: positionRemoved 3470 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veci difolt kod vecih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Vreme naplate potraživanja

---

#definisem funkciju za plotovanje
ploting(small.training,24,7)

Ignoring unknown parameters: positionRemoved 3536 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veca stopa difolta kod vecih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Vreme plaćanja dobavljačima

---

#definisem funkciju za plotovanje
ploting(small.training,25,7)

Ignoring unknown parameters: positionRemoved 3454 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-nezadovoljena, veci difolt kod manjih vrednosti, ipak cemo je uzeti, jer može ekonomski da se objasni rezultat
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Asset turnover

---

#definisem funkciju za plotovanje
ploting(small.training,26,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veca verovatnoca difolta kod manje medijane
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Rast EBITDA

---

#definisem funkciju za plotovanje
ploting(small.training,27,7)

Ignoring unknown parameters: positionRemoved 3092 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena, veca verovatnoca difolta kod manje medijane
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Stopa prinosa na sopstveni kapital pre oporezivanja

---

#definisem funkciju za plotovanje
ploting(lrge.training,28,7)

Ignoring unknown parameters: positionRemoved 120 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-ne znam koji mu je djavo ali evo ovde cemo medijana zdravog je -86.0846544 a nesolventnog je -92.9856293 sto odgovara radnoj hipotezi veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - ma da…

Stopa prinosa na ukupna sredstva pre oporezivanja

---

#definisem funkciju za plotovanje
ploting(small.training,29,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-ne znam koji mu je djavo ali evo ovde cemo medijana zdravog je -97.142369 a nesolventnog je -99.5386016 sto odgovara radnoj hipotezi
• Diskriminativnost -ima
• autlajeri - naravno ima ih
• normalnost - jedan od blizih…

Basic Earnings Power Ratio

---

#definisem funkciju za plotovanje
ploting(small.training,30,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je, veci difolt sa manjom vrednoscu
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

Rast prihoda od prodaje

---

#definisem funkciju za plotovanje
ploting(small.training,31,7)

Ignoring unknown parameters: positionRemoved 3054 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je veci difolt kod manjih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

Pokriće neto kamata

---

#definisem funkciju za plotovanje
ploting(small.training,32,7)

Ignoring unknown parameters: positionRemoved 2966 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je manja vrednost veca verovatnoca difolta
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

Cena tuđih izvora sredstava

---

#definisem funkciju za plotovanje
ploting(lrge.training,33,7,n=1)

Ignoring unknown parameters: positionRemoved 126 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je veci difolt kod vecih vrednosti
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

T1

---

#definisem funkciju za plotovanje
ploting(small.training,34,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

T2

---

#definisem funkciju za plotovanje
ploting(small.training,35,7)

Ignoring unknown parameters: positionRemoved 1796 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

T3

---

#definisem funkciju za plotovanje
ploting(small.training,36,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

T4

---

#definisem funkciju za plotovanje
ploting(small.training,37,7)

Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - masterpiece
• autlajeri - naravno ima ih
• normalnost - jook…

T5

---

#definisem funkciju za plotovanje
ploting(small.training,38,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

T21

---

#definisem funkciju za plotovanje
ploting(small.training,39,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-nezadovoljena
• Diskriminativnost - nema, za malo
• autlajeri - naravno ima ih
• normalnost - jook…

Altman Z-score 1

---

#definisem funkciju za plotovanje
ploting(small.training,40,7)

Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - masterpiece
• autlajeri - naravno ima ih
• normalnost - jook…

Altman Z-score 2

---

#definisem funkciju za plotovanje
ploting(small.training,41,7)

Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - ima
• autlajeri - naravno ima ih
• normalnost - jook…

Altman Z-score 3

---

#definisem funkciju za plotovanje
ploting(small.training,42,7)

Ignoring unknown parameters: positionRemoved 3394 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je
• Diskriminativnost - masterpiece
• autlajeri - naravno ima ih
• normalnost - jook…

Udeo u kapitalu banke

---

#definisem funkciju za plotovanje
ploting(small.training,43,7)

Ignoring unknown parameters: positionRemoved 3592 rows containing non-finite values (stat_density).D not labeled 0/1, assuming 1 = 0 and 2 = 1!

• Radna hipoteza-zadovoljena je, veci udeo losiji su u proseku
• Diskriminativnost - za vece vrednosti da
• autlajeri - naravno ima ih
• normalnost - jook…

---

Korelaciona matrica

U tabeli 5. ispod vidimo da najvecu diskriminacionu moc poseduje varijabla T14 odmah iza koje je ALtman 1.

#proracun
cor=cor(small.training.continualne[,c(-1,-31,-32,-33)], use = "complete.obs")
#dodajemo AUROC kao dodatnu kolonu pored varijable
corr_summary.small <- function (predictor) {
  response = factor(small.training.continualne[[1]])
  suppressMessages(auc(response, as.numeric(predictor)))
}
auc_sumarno.small<-sapply(small.training.continualne[,c(-1,-31,-32,-33)], corr_summary.small)
kor_diskr.small<-(cbind(auc_sumarno.small,cor)) 
formatRound(
            datatable(
                      kor_diskr.small,caption = "Tabela 5.:Sumarni prikaz",
                      filter = 'none'
                      ),
            columns = colnames(kor_diskr.small)
           )

as.data.frame(kor_diskr.small)

Ovde kreiram funkciju koja ce da filtrira varijable po kriterijumu korelacije. Naime, po ugledu na ² kao kriterijum granice koeficijenta korelacije preko koje ne bismo smeli prelaziti uzecemo vrednost od 0.5 koji ce u sprezi sa AUROC vrednosti selektirati jednu od dve varijable. Konacan izbor varijabli se vidi u korelacionoj tabeli ispod.

#assuming that table is n x (n+1) matrix where first column is AUROC value and the rest n x n is correlation matrix 
clean_cor.small<-corr_ellimination(kor_diskr.small)
knitr::kable(clean_cor.small, caption = "Tabela 6. skracena korelaciona tabela koja sadrzi varijable nad kojima ce se vrsiti dalja analiza")

	AUROC	Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja	T14	T12	Racio_novcane_likvidnosti_(Cash_ratio)	Asset_turnover	Racio_pokrica_obrtne_imovine	Stepen_zaduzenosti	udeo_u_kapitalu	Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)	Vreme_placanja_dobavljacima	Vreme_naplate_potrazivanja	Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja	Pokrice_neto_kamata	Rast_EBITDA	Racio_obrta_potrazivanja_od_kupaca	Vreme_kreditiranja_kupaca	Gotovinski_ciklus_1	Broj_zaposlenih
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja	0.7147068	1.0000000	0.1165590	0.4341258	0.1128484	0.1958647	0.0502256	-0.0263482	-0.0463149	0.0525652	-0.0062347	-0.0199984	0.0839210	-0.0157552	0.0348603	0.0172483	-0.0206373	0.0159378	0.0024429
T14	0.6973945	0.1165590	1.0000000	0.2611100	0.4795674	-0.0360332	0.0291147	-0.0122102	-0.0179755	0.0709050	-0.0010359	0.0198123	0.0028667	0.0012714	-0.0017285	0.0048825	-0.0020000	0.0166443	0.0058777
T12	0.6826563	0.4341258	0.2611100	1.0000000	0.1604509	0.0327279	0.0874663	-0.0455573	-0.0625975	0.0418614	-0.0109842	-0.0128638	0.0135095	-0.0002496	0.0004469	0.0132799	-0.0075940	0.0450543	-0.0570053
Racio_novcane_likvidnosti_(Cash_ratio)	0.6626892	0.1128484	0.4795674	0.1604509	1.0000000	0.0040580	0.0166795	-0.0052041	0.0028099	0.0210549	-0.0010279	-0.0036502	0.0032425	0.0085779	0.0031441	0.0291830	-0.0035404	0.0066690	-0.0071846
Asset_turnover	0.6606203	0.1958647	-0.0360332	0.0327279	0.0040580	1.0000000	0.0542484	-0.0028212	-0.0600007	-0.0064448	-0.0085182	-0.0413325	0.0194380	0.0055620	-0.0029900	0.0304797	-0.0424542	0.0057830	-0.0077756
Racio_pokrica_obrtne_imovine	0.6564486	0.0502256	0.0291147	0.0874663	0.0166795	0.0542484	1.0000000	-0.0156468	-0.0197482	0.0033306	-0.0728406	-0.0241162	0.0114168	-0.0008814	-0.0000493	-0.0010631	-0.0111443	0.0418198	0.0064618
Stepen_zaduzenosti	0.6424143	-0.0263482	-0.0122102	-0.0455573	-0.0052041	-0.0028212	-0.0156468	1.0000000	0.0061415	-0.0021876	0.0002599	0.0035013	-0.4251569	0.0008968	0.0104463	-0.0011129	0.0021755	-0.0045131	-0.0089361
udeo_u_kapitalu	0.6266576	-0.0463149	-0.0179755	-0.0625975	0.0028099	-0.0600007	-0.0197482	0.0061415	1.0000000	0.0053304	-0.0000342	0.0183950	-0.0031334	-0.0108029	0.0044632	0.0010618	0.0185163	-0.0005606	0.0252817
Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)	0.6165062	0.0525652	0.0709050	0.0418614	0.0210549	-0.0064448	0.0033306	-0.0021876	0.0053304	1.0000000	-0.0000778	0.0047461	0.0039572	0.0361806	0.0030683	-0.0008095	0.0252395	0.0055216	0.0063174
Vreme_placanja_dobavljacima	0.6159324	-0.0062347	-0.0010359	-0.0109842	-0.0010279	-0.0085182	-0.0728406	0.0002599	-0.0000342	-0.0000778	1.0000000	0.0081789	-0.0001728	-0.0002227	0.0000988	-0.0004297	0.0042198	-0.0542947	-0.0050480
Vreme_naplate_potrazivanja	0.6154063	-0.0199984	0.0198123	-0.0128638	-0.0036502	-0.0413325	-0.0241162	0.0035013	0.0183950	0.0047461	0.0081789	1.0000000	-0.0026687	-0.0001631	-0.0005822	-0.0025271	0.3153157	-0.0838092	-0.0141436
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja	0.6001106	0.0839210	0.0028667	0.0135095	0.0032425	0.0194380	0.0114168	-0.4251569	-0.0031334	0.0039572	-0.0001728	-0.0026687	1.0000000	-0.0021279	0.0022940	0.0008047	-0.0019686	0.0041697	-0.0028191
Pokrice_neto_kamata	0.5986841	-0.0157552	0.0012714	-0.0002496	0.0085779	0.0055620	-0.0008814	0.0008968	-0.0108029	0.0361806	-0.0002227	-0.0001631	-0.0021279	1.0000000	-0.0002522	0.0015299	0.0013857	0.0006617	0.0020257
Rast_EBITDA	0.5949098	0.0348603	-0.0017285	0.0004469	0.0031441	-0.0029900	-0.0000493	0.0104463	0.0044632	0.0030683	0.0000988	-0.0005822	0.0022940	-0.0002522	1.0000000	0.0001519	-0.0007876	0.0021314	-0.0033808
Racio_obrta_potrazivanja_od_kupaca	0.5944460	0.0172483	0.0048825	0.0132799	0.0291830	0.0304797	-0.0010631	-0.0011129	0.0010618	-0.0008095	-0.0004297	-0.0025271	0.0008047	0.0015299	0.0001519	1.0000000	-0.0029311	0.0032876	0.0035148
Vreme_kreditiranja_kupaca	0.5870546	-0.0206373	-0.0020000	-0.0075940	-0.0035404	-0.0424542	-0.0111443	0.0021755	0.0185163	0.0252395	0.0042198	0.3153157	-0.0019686	0.0013857	-0.0007876	-0.0029311	1.0000000	-0.0060538	-0.0158706
Gotovinski_ciklus_1	0.5806210	0.0159378	0.0166443	0.0450543	0.0066690	0.0057830	0.0418198	-0.0045131	-0.0005606	0.0055216	-0.0542947	-0.0838092	0.0041697	0.0006617	0.0021314	0.0032876	-0.0060538	1.0000000	-0.0101120
Broj_zaposlenih	0.5734997	0.0024429	0.0058777	-0.0570053	-0.0071846	-0.0077756	0.0064618	-0.0089361	0.0252817	0.0063174	-0.0050480	-0.0141436	-0.0028191	0.0020257	-0.0033808	0.0035148	-0.0158706	-0.0101120	1.0000000

Tretman problematicnih varijabli

Ovako, generalno, ono sto nismo (nismo hteli komentarisati) komentarisali su simetricnosti varijabli. Pozitivno asimetricno je bar pola posmatranih varijabli tako da bi valjala neka vrsta logaritmovane transformacije uz vodjenje racuna o negativnim vrednostima (na primer transformacija tipa: \(\log(var + \min(var) + 1))\) bi se pobrinula za negativne vrednosti. Box Za negativnu asimetricnost bi koristili eventualno eksponencijalnu transformaciju. Videcemo posle prvog stepwisea i AUROC-a.

Ipak, ovde cemo se koncentrisati na par prethodno napomenutih varijabli.

Pokriće neto kamata

Prvo cemo podeliti varijablu na n intervala. Za optimalan broj intervala mozemo iskoristiti drugu funkciju koja ima algoritam koji bira broj intervala od 10 do 20 na osnovu odredjenih kriterijuma, vidi help funkcije dole.

#kreiram tabelu od pokrica neto kamata i indikatora default-a
data<-small.training[,c("default.y","Pokrice_neto_kamata")]
IV <- create_infotables(data=data,
                        y="default.y", 
                        parallel=FALSE)
IV_Value = data.frame(IV$Summary)
IV_Value

IV$Tables

$Pokrice_neto_kamata

plot_infotables(IV,"Pokrice_neto_kamata")

Dakle optimum je 10, imajuci u obzir nedostajuce vrednosti kao 11 kategoriju. Sada racunamo fiting funkciju transformacije. Generalno, mogli bismo podeliti varijablu u 8 kategorickih, ali ja bih izbegao to. Hajde prvo da vidimo empirijsku distribuciju, pa da fitujemo.

#izracunam medijanu po svakom binu

Kategoricke promenljive:

Postoje tri kategoricke varijable koje je potrebno analizirati:

• Sifra opstine-generalno veliki broj opstina ce praviti problem, preporuka je da se potencijalno izvrsi podela na Beograd i ostatak Srbije, ili, na velike gradove i male opstine, gde bi u velike gradove usli Beograd, Nis, Novi Sad, i na kraju cemo pokusati da upotrebimo ekonomsku razvijenost opstina kao pokazatelj. Ona se menja svake godine, ali kostur ostaje slican, pa bismo u ovom delu razvijanja modela uzeli vrednost iz 2014. godine, a ukoliko se ispostavi kao bitan faktor mozemo zatraziti seriju, koja, medjutim ne ide pre 2010. godine.
• Sifra sektora-generalno, ne postoji opste misljenje o ovoj varijabli, niti opravdanost zasto bi ona usla u obracun, stoji da je broj difolta po sektorima razlicit, ali neki sektori imaju vrlo mali broj observacija, tako da cemo morati pregrupisati varijable na najvece sektore i ostale, zavisno od vec navedenih kriterijuma u pocetku ovog poglavlja.
  
• Strani investitor-situacija je jasna

rpivotTable(lrge.training.kategoricke,
            rows = "default.y", 
            cols = "Strani_investitor",
            aggregatorName = "Count as Fraction of Columns")

Sifra sektora:

freq_table=function(dta,kategorical,default){
  kategorical=as.name(kategorical)
  default=as.name(default)
  tmp=dta[,.N,by=.(eval(kategorical),eval(default))]
  frekvenca_sektor<-dcast(tmp,eval(kategorical)~eval(default),value.var="N")
  frekvenca_sektor$`0`[is.na(frekvenca_sektor$`0`)]=0
  frekvenca_sektor$`1`[is.na(frekvenca_sektor$`1`)]=0
  ukupno<-frekvenca_sektor$`0`+frekvenca_sektor$`1`
  frekvenca_sektor<-cbind.data.frame(frekvenca_sektor,ukupno)
  frekvenca_sektor[,default_rate:=frekvenca_sektor$`1`/ukupno]
  as.data.frame(frekvenca_sektor)
}
freq_table(small.training.kategoricke,"Sifra_sektor","default.y")

small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="B"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="G"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="J"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="P"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="Q"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="R"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="B"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="G"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="J"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="P"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="Q"]<-"4%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="R"]<-"4%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="M"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="N"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="S"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="F"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="M"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="N"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="S"]<-"6%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="F"]<-"6%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="H"]<-"3%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="E"]<-"3%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="H"]<-"3%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="E"]<-"3%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="I"]<-"10%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="J"]<-"9%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="K"]<-"9%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="I"]<-"10%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="J"]<-"9%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="K"]<-"9%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="A"]<-"5%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="C"]<-"5%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="D"]<-"5%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="A"]<-"5%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="C"]<-"5%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="D"]<-"5%"
small.training.kategoricke$Sifra_sektor1[small.training.kategoricke$Sifra_sektor=="L"]<-"14%"
small.test.kategoricke$Sifra_sektor1[small.test.kategoricke$Sifra_sektor=="L"]<-"14%"
freq_table(small.training.kategoricke,"Sifra_sektor1","default.y")

data_sifra_sektor.small<-small.training.kategoricke[,c("default.y","Sifra_sektor1")]
IV_sifra_sektor.small<-create_infotables(data=data_sifra_sektor.small,
                        y="default.y", 
                        parallel=FALSE)
IV_sifra_sektor.small$Tables

$Sifra_sektor1

NA

Information value je bzveze, probajmo sada jos da pregrupišemo:

small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="10%"]<-"10%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="14%"]<-"14%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="9%"]<-"6-9%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="6%"]<-"6-9%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="10%"]<-"10%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="14%"]<-"14%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="9%"]<-"6-9%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="6%"]<-"6-9%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="5%"]<-"5%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="4%"]<-"5%"
small.training.kategoricke$Sifra_sektor2[small.training.kategoricke$Sifra_sektor1=="3%"]<-"3%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="5%"]<-"5%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="4%"]<-"5%"
small.test.kategoricke$Sifra_sektor2[small.test.kategoricke$Sifra_sektor1=="3%"]<-"3%"
data_sifra_sektor.small<-small.training.kategoricke[,c("default.y","Sifra_sektor2")]
IV_sifra_sektor.small<-create_infotables(data=data_sifra_sektor.small,
                        y="default.y", 
                        parallel=FALSE)
IV_sifra_sektor.small$Tables

$Sifra_sektor2

NA

Zakljucujemo da, sektor kod malih i mikro preduzeca ne igra bas bitnu ulogu ali cemo uzeti ovu varijablu. ####Sifra opstine:

freq_table(small.training.kategoricke,"Sifra_opstine","default.y")

Za pocetak cemo smestiti sve opstine koje imaju manje od 100 duznika i manje od 5 difoltera u jednu klasu.

temp.table<-freq_table(small.training.kategoricke,"Sifra_opstine","default.y")
ostalo.small.names<-temp.table[temp.table$ukupno<100,1]
small.training.kategoricke$Sifra_opstine1<-small.training.kategoricke$Sifra_opstine
small.training.kategoricke$Sifra_opstine1[small.training.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.test.kategoricke$Sifra_opstine1<-small.test.kategoricke$Sifra_opstine
small.test.kategoricke$Sifra_opstine1[small.test.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
ostalo.small.names<-temp.table[temp.table$`1`<5,1]
small.training.kategoricke$Sifra_opstine1[small.training.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.training.kategoricke$Sifra_opstine1[small.training.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.test.kategoricke$Sifra_opstine1[small.test.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
small.test.kategoricke$Sifra_opstine1[small.test.kategoricke$Sifra_opstine%in%ostalo.small.names]<-"ostalo"
temp.table<-freq_table(small.training.kategoricke,"Sifra_opstine1","default.y")
temp.table

Svstavamo ih po stopi difolta da vidimo da li se sta moze promeniti

small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
                                            c(70041, 70955, 80403)] <- "2%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
                                            c(70041, 70955, 80403)] <- "2%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
                                            c(70653,71099,71242,79065,80128)] <- "3%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
                                            c(70653,71099,71242,79065,80128)] <- "3%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in% c(70033,70483,70904,71048,71269,79022,79057,80110,80438,80462,"ostalo")] <- "4%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in% c(70033,70483,70904,71048,71269,79022,79057,80110,80438,80462,"ostalo")] <- "4%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(89010,80466,80420,80357,80314,80195,80179,80152,80071,70670,70459,70360,70645)] <- "5%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(89010,80466,80420,80357,80314,80195,80179,80152,80071,70670,70459,70360,70645)] <- "5%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(70726,70734,71102,71200,79014,79049,80063,80446)] <- "6%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(70726,70734,71102,71200,79014,79049,80063,80446)] <- "6%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(70874,70564,70386,80381)] <- "7%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(70874,70564,70386,80381)] <- "7%"
small.test.kategoricke$Sifra_opstine2[small.test.kategoricke$Sifra_opstine1 %in%
c(80209,80233)] <- "8>%"
small.training.kategoricke$Sifra_opstine2[small.training.kategoricke$Sifra_opstine1 %in%
c(80209,80233)] <- "8>%"
data_sifra_ostine.small<-small.training.kategoricke[,c("default.y","Sifra_opstine2")]
IV_sifra_sektor<-create_infotables(data=data_sifra_ostine.small,
                        y="default.y", 
                        parallel=FALSE)
IV_sifra_sektor$Tables

$Sifra_opstine2

NA

probajmo da pregrupisemo

small.training.kategoricke$Sifra_opstine3<-small.training.kategoricke$Sifra_opstine2 
small.training.kategoricke$Sifra_opstine3[small.training.kategoricke$Sifra_opstine2 %in%
                                            c("4%","5%")] <- "4-5%"
small.test.kategoricke$Sifra_opstine3<-small.test.kategoricke$Sifra_opstine2 
small.test.kategoricke$Sifra_opstine3[small.test.kategoricke$Sifra_opstine2 %in%
                                            c("4%","5%")] <- "4-5%"
#small.training.kategoricke$Sifra_opstine3[(small.training.kategoricke$Sifra_opstine2 %in%
                                            #c("5%","6%","7%","8>%"))] <- "high%"
data_sifra_ostine.small2<-small.training.kategoricke[,c("default.y","Sifra_opstine3")]
IV_sifra_sektor2<-create_infotables(data=data_sifra_ostine.small2,
                        y="default.y", 
                        parallel=FALSE)
IV_sifra_sektor2$Tables        

$Sifra_opstine3

freq_table(small.training.kategoricke,"Sifra_opstine3","default.y")        

cak i ovako rasporedjene imaju slabu prediktivnu moc. pokusavamo sada po razvijenosti opstina, ovo necemo uzimati jer nema nekog logicnog objasnjenja a diskriminativnost i nije velika

IV_razvijenost2$Tables   

$Razvijenost

NA

beznacajno, konacan zakljucak je da idemo sa varijablom Sifra_opstine3 ####Strani investitor

Pogledajmo prvo frekvencionu tabelu

freq_table(small.training.kategoricke,"Strani_investitor","default.y")

Postoji razlika, imajuci u vidu da ovde imamo samo dve varijable, to je i ocekivano, hajde da vidimo IV:

WOETable(X=as.factor(small.training.kategoricke$Strani_investitor),Y=(small.training.kategoricke$default.y-1)*(-1))

nema uticaja

Velicina

WOETable(X=as.factor(small.training.kategoricke$Velicina),Y=(small.training.kategoricke$default.y-1)*(-1))

marginalno

Evaluacija regresije

Dosadasnji rezultati:

Otpadanje usled NA vrednosti, prezivele su sledece varijable:

preziveli.NA.small

 [1] "Broj_zaposlenih"                                                           
 [2] "Velicina"                                                                  
 [3] "Rigorozni_racio_redukovane_(monetarne)_likvidnosti"                        
 [4] "Opsti_racio_likvidnosti"                                                   
 [5] "Stepen_zaduzenosti"                                                        
 [6] "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)"
 [7] "Racio_pokrica_obrtne_imovine"                                              
 [8] "Gotovinski_ciklus_1"                                                       
 [9] "Vreme_vezivanja_zaliha"                                                    
[10] "Vreme_kreditiranja_kupaca"                                                 
[11] "Vreme_naplate_potrazivanja"                                                
[12] "Vreme_placanja_dobavljacima"                                               
[13] "Asset_turnover"                                                            
[14] "Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja"                       
[15] "Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja"                         
[16] "Basic_Earnings_Power_Ratio"                                                
[17] "Cena_tudjih_izvora_sredstava"                                              
[18] "T11"                                                                       
[19] "T12"                                                                       
[20] "T13"                                                                       
[21] "T14"                                                                       
[22] "T15"                                                                       
[23] "T21"                                                                       
[24] "Altman I"                                                                  
[25] "Altman emerging markets"                                                   
[26] "Altman private firms"                                                      
[27] "udeo_u_kapitalu"                                                           

Ciscenje usled korelacija i AUROC-a manjeg od 0.55

preziveli.corr.AUC.small

 [1] "Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja"                         
 [2] "T14"                                                                       
 [3] "T12"                                                                       
 [4] "Racio_novcane_likvidnosti_(Cash_ratio)"                                    
 [5] "Asset_turnover"                                                            
 [6] "Racio_pokrica_obrtne_imovine"                                              
 [7] "Stepen_zaduzenosti"                                                        
 [8] "udeo_u_kapitalu"                                                           
 [9] "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)"
[10] "Vreme_placanja_dobavljacima"                                               
[11] "Vreme_naplate_potrazivanja"                                                
[12] "Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja"                       
[13] "Pokrice_neto_kamata"                                                       
[14] "Rast_EBITDA"                                                               
[15] "Racio_obrta_potrazivanja_od_kupaca"                                        
[16] "Vreme_kreditiranja_kupaca"                                                 
[17] "Gotovinski_ciklus_1"                                                       
[18] "Broj_zaposlenih"                                                           

Presek ova dva nastavlja u multivariate.

odabrani.small

 [1] "Racio_novcane_likvidnosti_(Cash_ratio)"                                    
 [2] "Broj_zaposlenih"                                                           
 [3] "Stepen_zaduzenosti"                                                        
 [4] "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)"
 [5] "Racio_pokrica_obrtne_imovine"                                              
 [6] "Gotovinski_ciklus_1"                                                       
 [7] "Vreme_kreditiranja_kupaca"                                                 
 [8] "Vreme_naplate_potrazivanja"                                                
 [9] "Vreme_placanja_dobavljacima"                                               
[10] "Asset_turnover"                                                            
[11] "Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja"                       
[12] "Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja"                         
[13] "T12"                                                                       
[14] "T14"                                                                       
[15] "udeo_u_kapitalu"                                                           

Kreiramo zavrsni uzorak:

---

Tretman nedostajucih i tretman autlajera, potom dodajemo kategoricke

finalni_small<-small.training[,c(odabrani.small),with=F]
finalni_small.test<-small.test[,c(odabrani.small),with=F]
#finalni_lrge<-cbind.data.frame(finalni_lrge,Asset_turnover$Asset_turnover.tr,Pokrice_neto_kamata$Pokrice_neto_kamata.tr)
finalni_small<-as.data.table(sapply(finalni_small,replace_outlier_with_quantile))
finalni_small.test<-as.data.table(sapply(finalni_small.test,replace_outlier_with_quantile))
finalni_small$default.y<-small.training$default.y
finalni_small<-replace_missing_with_knn(finalni_small)
finalni_small$default.y<-NULL

opciono, transformacija

AA<-data.frame(1:nrow(finalni_small));n=1

for(i in names(finalni_small)["default.y" != names(finalni_small)]) {

  n = n + 1
  tmp <- calibrate_parameters(finalni_small, i, "default.y")
  AA <- cbind.data.frame(AA, tmp[[7]])
  names(AA)[n] <- names(finalni_small)[n]
}


finalni_small <- AA
remove(AA)
finalni_small[, 1] <- NULL
finalni_small$default.y <- default.y
finalni_small <- as.data.table(finalni_small)

Dodajemo dve kategoricke:

#spajamo sa kategorickim i skidamo par viskova kategorickih, velicina, total
finalni_small <-
  cbind.data.frame(finalni_small, small.training.kategoricke[, c("Velicina","Sifra_sektor2","Sifra_opstine3")])
finalni_small.test <-
  cbind.data.frame(finalni_small.test, small.test.kategoricke[, c("Velicina","Sifra_sektor2","Sifra_opstine3")])
#pretvaram kategoricke u faktor da bi ih glm posmatrao kao kategoricke
finalni_small$Sifra_sektor2 <- as.factor(finalni_small$Sifra_sektor2)
finalni_small$Velicina <-as.factor(finalni_small$Velicina)
finalni_small$Sifra_opstine3 <-as.factor(finalni_small$Sifra_opstine3)
finalni_small.test$Sifra_sektor2 <- as.factor(finalni_small.test$Sifra_sektor2)
finalni_small.test$Velicina <-as.factor(finalni_small.test$Velicina)
finalni_small.test$Sifra_opstine3 <-as.factor(finalni_small.test$Sifra_opstine3)

Dugo ocekivani trenutak:

model.null.small = glm(default.y ~ 1,
                 data=finalni_small,
                 family = binomial(link="logit")
                 )
model.full.small = glm(default.y ~ .,
                 data=finalni_small,
                 family = binomial(link="logit")
                 )
    
step(model.null.small,
     scope = list(upper=model.full.small,lower=model.null.small),
             direction="forward",
             
             data=finalni_small,trace=0)

Call:  glm(formula = default.y ~ T12 + Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + 
    Asset_turnover + `Racio_novcane_likvidnosti_(Cash_ratio)` + 
    Sifra_opstine3 + udeo_u_kapitalu + Stepen_zaduzenosti + Vreme_kreditiranja_kupaca + 
    Sifra_sektor2 + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` + 
    Broj_zaposlenih + Racio_pokrica_obrtne_imovine + Velicina + 
    T14 + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja, 
    family = binomial(link = "logit"), data = finalni_small)

Coefficients:
                                                                 (Intercept)  
                                                                  -5.6165874  
                                                                         T12  
                                                                  -2.7772841  
                           Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja  
                                                                  -0.0289081  
                                                              Asset_turnover  
                                                                  -0.1854926  
                                    `Racio_novcane_likvidnosti_(Cash_ratio)`  
                                                                  -1.6625834  
                                                            Sifra_opstine33%  
                                                                   0.3689998  
                                                          Sifra_opstine34-5%  
                                                                   0.6810619  
                                                            Sifra_opstine36%  
                                                                   0.9404356  
                                                            Sifra_opstine37%  
                                                                   0.9770421  
                                                           Sifra_opstine38>%  
                                                                   1.1036830  
                                                             udeo_u_kapitalu  
                                                                   0.0269230  
                                                          Stepen_zaduzenosti  
                                                                   0.0076335  
                                                   Vreme_kreditiranja_kupaca  
                                                                   0.0003728  
                                                            Sifra_sektor214%  
                                                                  -0.0169039  
                                                             Sifra_sektor23%  
                                                                  -0.6711506  
                                                             Sifra_sektor25%  
                                                                  -0.3120925  
                                                           Sifra_sektor26-9%  
                                                                  -0.1988994  
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)`  
                                                                   0.0009682  
                                                             Broj_zaposlenih  
                                                                  -0.0021480  
                                                Racio_pokrica_obrtne_imovine  
                                                                   0.0114913  
                                                                   Velicina2  
                                                                  -0.1238959  
                                                                         T14  
                                                                   0.0104025  
                         Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja  
                                                                  -0.0013645  

Degrees of Freedom: 35913 Total (i.e. Null);  35891 Residual
Null Deviance:      14240 
Residual Deviance: 12580    AIC: 12630

model1.small <-glm(formula = default.y ~ T12 + Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + 
    Asset_turnover + `Racio_novcane_likvidnosti_(Cash_ratio)` + 
    Sifra_opstine3 + udeo_u_kapitalu + Stepen_zaduzenosti + Vreme_kreditiranja_kupaca + 
    Sifra_sektor2 + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` + 
    Broj_zaposlenih + Racio_pokrica_obrtne_imovine + Velicina + 
    T14 + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja, 
    family = binomial(link = "logit"), data = finalni_small)
  
model1.small.data.frame<-data.frame(fit1=model1.small$fitted.values, dif1=model1.small$model$default.y)

step(model.full.small,
     scope = list(lower=model.full.small,upper=model.null.small),
             direction="backward",
             data=finalni_small, trace=0)

Call:  glm(formula = default.y ~ `Racio_novcane_likvidnosti_(Cash_ratio)` + 
    Broj_zaposlenih + Stepen_zaduzenosti + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` + 
    Racio_pokrica_obrtne_imovine + Gotovinski_ciklus_1 + Vreme_kreditiranja_kupaca + 
    Vreme_naplate_potrazivanja + Vreme_placanja_dobavljacima + 
    Asset_turnover + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja + 
    Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + T12 + 
    T14 + udeo_u_kapitalu + Velicina + Sifra_sektor2 + Sifra_opstine3, 
    family = binomial(link = "logit"), data = finalni_small)

Coefficients:
                                                                 (Intercept)  
                                                                  -5.607e+00  
                                    `Racio_novcane_likvidnosti_(Cash_ratio)`  
                                                                  -1.659e+00  
                                                             Broj_zaposlenih  
                                                                  -2.205e-03  
                                                          Stepen_zaduzenosti  
                                                                   7.742e-03  
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)`  
                                                                   9.621e-04  
                                                Racio_pokrica_obrtne_imovine  
                                                                   1.258e-02  
                                                         Gotovinski_ciklus_1  
                                                                  -7.728e-05  
                                                   Vreme_kreditiranja_kupaca  
                                                                   4.737e-04  
                                                  Vreme_naplate_potrazivanja  
                                                                  -8.573e-05  
                                                 Vreme_placanja_dobavljacima  
                                                                  -4.906e-06  
                                                              Asset_turnover  
                                                                  -1.883e-01  
                         Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja  
                                                                  -1.357e-03  
                           Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja  
                                                                  -2.888e-02  
                                                                         T12  
                                                                  -2.769e+00  
                                                                         T14  
                                                                   1.052e-02  
                                                             udeo_u_kapitalu  
                                                                   2.787e-02  
                                                                   Velicina2  
                                                                  -1.320e-01  
                                                            Sifra_sektor214%  
                                                                  -7.684e-03  
                                                             Sifra_sektor23%  
                                                                  -6.732e-01  
                                                             Sifra_sektor25%  
                                                                  -3.097e-01  
                                                           Sifra_sektor26-9%  
                                                                  -1.912e-01  
                                                            Sifra_opstine33%  
                                                                   3.658e-01  
                                                          Sifra_opstine34-5%  
                                                                   6.793e-01  
                                                            Sifra_opstine36%  
                                                                   9.400e-01  
                                                            Sifra_opstine37%  
                                                                   9.722e-01  
                                                           Sifra_opstine38>%  
                                                                   1.099e+00  

Degrees of Freedom: 35913 Total (i.e. Null);  35888 Residual
Null Deviance:      14240 
Residual Deviance: 12580    AIC: 12630

 model2.small=  glm(formula = default.y ~ `Racio_novcane_likvidnosti_(Cash_ratio)` + 
    Broj_zaposlenih + Stepen_zaduzenosti + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` + 
    Racio_pokrica_obrtne_imovine + Gotovinski_ciklus_1 + Vreme_kreditiranja_kupaca + 
    Vreme_naplate_potrazivanja + Vreme_placanja_dobavljacima + 
    Asset_turnover + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja + 
    Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + T12 + 
    T14 + udeo_u_kapitalu + Velicina + Sifra_sektor2 + Sifra_opstine3, 
    family = binomial(link = "logit"), data = finalni_small)
model2.small.data.frame=data.frame(fit2=model2.small$fitted.values, dif2=model2.small$model$default.y)

Wald statistik:

library(car)
Anova(model1.small, type="II", test="Wald")

Analysis of Deviance Table (Type II tests)

Response: default.y
                                                                             Df    Chisq
T12                                                                           1 214.3368
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja                             1  44.5433
Asset_turnover                                                                1  45.5246
`Racio_novcane_likvidnosti_(Cash_ratio)`                                      1  68.2248
Sifra_opstine3                                                                5  52.3861
udeo_u_kapitalu                                                               1  62.2519
Stepen_zaduzenosti                                                            1  32.1689
Vreme_kreditiranja_kupaca                                                     1  14.0409
Sifra_sektor2                                                                 4  22.4703
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)`  1  12.6258
Broj_zaposlenih                                                               1   4.8651
Racio_pokrica_obrtne_imovine                                                  1   4.1235
Velicina                                                                      1   4.3035
T14                                                                           1   2.7113
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja                           1   2.5171
                                                                             Pr(>Chisq)    
T12                                                                           < 2.2e-16 ***
Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja                             2.488e-11 ***
Asset_turnover                                                                1.507e-11 ***
`Racio_novcane_likvidnosti_(Cash_ratio)`                                      < 2.2e-16 ***
Sifra_opstine3                                                                4.495e-10 ***
udeo_u_kapitalu                                                               3.022e-15 ***
Stepen_zaduzenosti                                                            1.413e-08 ***
Vreme_kreditiranja_kupaca                                                     0.0001789 ***
Sifra_sektor2                                                                 0.0001615 ***
`Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)`  0.0003805 ***
Broj_zaposlenih                                                               0.0274049 *  
Racio_pokrica_obrtne_imovine                                                  0.0422917 *  
Velicina                                                                      0.0380345 *  
T14                                                                           0.0996418 .  
Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja                           0.1126168    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Langrange multiplier test:

anova(model1.small,
      model.null.small,
      test="Chisq")

Analysis of Deviance Table

Model 1: default.y ~ T12 + Stopa_prinosa_na_ukupna_sredstva_pre_oporezivanja + 
    Asset_turnover + `Racio_novcane_likvidnosti_(Cash_ratio)` + 
    Sifra_opstine3 + udeo_u_kapitalu + Stepen_zaduzenosti + Vreme_kreditiranja_kupaca + 
    Sifra_sektor2 + `Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza_(Interest_Coverage_Ratio)` + 
    Broj_zaposlenih + Racio_pokrica_obrtne_imovine + Velicina + 
    T14 + Stopa_prinosa_na_sopstveni_kapital_pre_oporezivanja
Model 2: default.y ~ 1
  Resid. Df Resid. Dev  Df Deviance  Pr(>Chi)    
1     35891      12584                           
2     35913      14243 -22  -1659.5 < 2.2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Drugi nacin

 auroc.1<-auc(
      as.numeric(model1.small.data.frame$dif1),
      as.numeric(model1.small.data.frame$fit1))
 auroc.2<-auc(
      as.numeric(model2.small.data.frame$dif2),
      as.numeric(model2.small.data.frame$fit2))
 
 c(auroc.1,auroc.2)

[1] 0.7728342 0.7726643

validacioni uzorak

model1.small.pred<-as.numeric(predict(model1.small, newdata = finalni_small.test, type = "response"))
dif.small.valid<-small.test$default.y
model2.small.pred<-as.numeric(predict(model2.small, newdata = finalni_small.test, type = "response"))
auroc.1.pred<-auc(dif.small.valid, model1.small.pred)
auroc.2.pred<-auc(dif.small.valid, model2.small.pred)
c(auroc.1.pred,auroc.2.pred)

[1] 0.7467612 0.7469133

my.vars.small <-finalni_small# a matrix with your 14 different environmental variables
names(my.vars.small)[c(1, 4)] <-
  c("Racio_novcane_likvidnosti",
  "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza")
my.vars.small.valid <- finalni_small.test#
names(my.vars.small.valid)[c(1, 4)] <-
  c("Racio_novcane_likvidnosti",
  "Racio_pokrica_kamata_zaradom_pre_kamata_i_poreza")
my.vars.small$default.y=NULL

Adding new column 'default.y' then assigning NULL (deleting it).

library(speedglm)
nvar.small<-ncol(my.vars.small)
#colnames(my.vars) <- paste("var", 1:nvar, sep="") # add row names "var1" - "var14"
my.grad.data.small <- 1:nvar.small
sum.vars.small <- vector()
auc.p.small <- vector()
auc.pred.smal<-vector()
comb.mat.small <- matrix(numeric(0), nrow=nvar.small, ncol=0) # initialise the matrix containing all combinations
dif.small.valid<-small.test$default.y
for ( i in 1:nvar.small ) { # generate and store all possible combination of sums of the 14 variables
  
  t.mat.small <- combn(my.grad.data.small, m=i)
  
  comb.mat.small <- cbind(comb.mat.small, rbind(t.mat.small, matrix(NA, ncol=dim(t.mat.small)[2] , nrow=nvar.small-i)))
}
colnms.small<-colnames(my.vars.small)
my.vars.small$default.y=small.training$default.y
num.of.vars.small <- apply(as.data.frame(comb.mat.small),c(2)
                      , function(x) {
                      sum(as.numeric(!is.na(x)))
                      })
for ( j in 1:dim(comb.mat.small)[2] ) { # calculate and store the R2 for all combinations
  
  #sum.vec <- rowSums(my.vars[, comb.mat[, j]], na.rm=TRUE)
  sum.vars.small[j] <- paste( colnms.small[c(na.omit(comb.mat.small[, j]))], 
    collapse="+")
  relacija.small=as.formula(paste("default.y ~ ",sum.vars.small[j],sep = ""))
  model.small = speedglm(relacija.small,
                   data = my.vars.small,
                   y=TRUE,
                   fitted = TRUE,
                   family = binomial(link = "logit"))
  model.small.data.frame=data.frame(fit=fitted.values(model.small), dif=model.small$y)
  #browser()
  auc.p.small[j] <- auc_roc(as.numeric(model.small.data.frame$fit),as.numeric(model.small.data.frame$dif))
  #auc.p.small[j] <-fastAUC(as.numeric(model.small.data.frame$fit),as.numeric(model.small.data.frame$dif))
  
  
  model.small.pred<-as.numeric(predict(model.small, newdata = my.vars.small.valid, type = "response"))
  
  auc.pred.smal[j]<-auc_roc( model.small.pred,dif.small.valid)
  #auc.pred.smal[j]<-fastAUC( model.small.pred,dif.small.valid)
  
  if(j %in% round(seq(from=1, to=dim(comb.mat.small)[2],length.out = 100))) print(j/dim(comb.mat.small)[2])
  #print(j)
  #if(j==8) browser()
}

[1] 3.814712e-06
[1] 0.01010517
[1] 0.02020653
[1] 0.03030789
[1] 0.04040924
[1] 0.05050678
[1] 0.06060814
[1] 0.0707095
[1] 0.08081086
[1] 0.09091221
[1] 0.1010136
[1] 0.1111149
[1] 0.1212163
[1] 0.1313176
[1] 0.141419
[1] 0.1515165
[1] 0.1616179
[1] 0.1717193
[1] 0.1818206
[1] 0.191922
[1] 0.2020233
[1] 0.2121247
[1] 0.222226
[1] 0.2323274
[1] 0.2424288
[1] 0.2525263
[1] 0.2626276
[1] 0.272729
[1] 0.2828304
[1] 0.2929317
[1] 0.3030331
[1] 0.3131344
[1] 0.3232358
[1] 0.3333371
[1] 0.3434385
[1] 0.353536
[1] 0.3636374
[1] 0.3737388
[1] 0.3838401
[1] 0.3939415
[1] 0.4040428
[1] 0.4141442
[1] 0.4242455
[1] 0.4343469
[1] 0.4444483
[1] 0.4545458
[1] 0.4646472
[1] 0.4747485
[1] 0.4848499
[1] 0.4949512
[1] 0.5050526
[1] 0.5151539
[1] 0.5252553
[1] 0.5353567
[1] 0.545458
[1] 0.5555556
[1] 0.5656569
[1] 0.5757583
[1] 0.5858596
[1] 0.595961
[1] 0.6060623
[1] 0.6161637
[1] 0.6262651
[1] 0.6363664
[1] 0.6464678
[1] 0.6565653
[1] 0.6666667
[1] 0.676768
[1] 0.6868694
[1] 0.6969707
[1] 0.7070721
[1] 0.7171735
[1] 0.7272748
[1] 0.7373762
[1] 0.7474775
[1] 0.7575751
[1] 0.7676764
[1] 0.7777778
[1] 0.7878791
[1] 0.7979805
[1] 0.8080818
[1] 0.8181832
[1] 0.8282846
[1] 0.8383859
[1] 0.8484873
[1] 0.8585848
[1] 0.8686862
[1] 0.8787875
[1] 0.8888889
[1] 0.8989902
[1] 0.9090916
[1] 0.919193
[1] 0.9292943
[1] 0.9393957
[1] 0.949497
[1] 0.9595946
[1] 0.9696959
[1] 0.9797973
[1] 0.9898986
[1] 1

result.frame.small <- data.frame(combination=sum.vars.small, auc.p.small=auc.p.small, auc.valid.small=auc.pred.smal,num_of_vars=num.of.vars.small)
result.frame.small.sorted <- result.frame.small[order(auc.pred.smal, decreasing=TRUE), ]
head(result.frame.small.sorted, n=100) # the 10 "best" combinations

---

1. Vidi Rating Models and Validation - Oesterreichische Nationalbank (OeNB).↩

2. Hayden, E., & Porath, D. (2011). Statistical Methods to Develop Rating Models. In B. Engelmann, and R. Rauhmeier (Eds.), The Basel II Risk Parameters: Estimation, Validation, Stress Testing – with Applications to Loan Risk Management (pp. 1–12). New York: Springer.↩